home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / RLIO.XPL < prev    next >
Text File  |  2001-09-30  |  6KB  |  239 lines
  1. \RLIO.XPL    APR-08-89
  2. \Real input/output routines
  3.  
  4. code    \Complete set of INTM.68K intrinsics
  5.     ABS= 0,        RAN= 1,        REM= 2,        RESERVE= 3,
  6.     SWAP= 4,    EXTEND= 5,    RESTART= 6,    CHIN= 7,
  7.     CHOUT= 8,    CRLF= 9,    INTIN= 10,    INTOUT= 11,
  8.     TEXT= 12,    OPENI= 13,    OPENO= 14,    CLOSE= 15,
  9.     ABORT= 16,    TRAP= 17,    FREE= 18,    RERUN= 19,
  10.     GETHP= 20,    SETHP= 21,    GETERR= 22,    CURSOR= 23,
  11.     SCAN= 24,    SETRUN= 25,    HEXIN= 26,    HEXOUT= 27,
  12.     CHAIN= 28,    OPENF= 29,    WRITE= 30,    READ= 31,
  13.     TESTPT= 32,    FGET= 33,    FSAVE= 35,
  14.     BLIT= 36,    BUTTON= 37,    MOUSE= 38,    SOUND= 39,
  15.     CLEAR= 40,    POINT= 41,    LINE= 42,    MOVE= 43,
  16.     SCREEN= 44,    BLOCK= 45,    FIX= 50,    BACKUP= 64,
  17.     SETBUF= 107,
  18.     BITMAP= 108,    BITMAP2= 109,    VIEW= 110,    PALETTE= 111,
  19.     CARRY= 112,    PEEK_W= 113,    POKE_W= 114,    PEEK_L= 115,
  20.     POKE_L= 116,    SWAP_W= 117,    EXT_L= 118,    CURSOR1= 119,
  21.     BUTES1= 120,    SHOCUR1= 121,    DEVINFO= 122,    UNTINFO= 123,
  22.     BUTES= 124,    GETKEY= 125,    KEYHIT= 126,    SHOCUR= 127;
  23. code real        RLRES= 46,    \RLIN= 47,\    \RLOUT= 48,\
  24.     FLOAT= 49,    RLABS= 51,    \FORMAT= 52,\    SQRT= 53,
  25.     LN= 54,        EXP= 55,    SIN= 56,    \ATAN2= 57,\
  26.     \MOD= 58,\    LOG= 59,    COS= 60,    TAN= 61,
  27.     ASIN= 62,    ACOS= 63,    ATAN= 68;
  28.  
  29.  
  30.  
  31. link proc FORMAT(MDIGIT, NDIGIT);    \Set format parameters for RLOUT
  32. int    MDIGIT, NDIGIT;
  33. addr    ADDR;
  34. begin
  35. ADDR:= $7FE;
  36. ADDR(0):= MDIGIT;
  37. ADDR(1):= NDIGIT;
  38. end;    \FORMAT
  39.  
  40. \----------------------------------------------------------------------
  41.  
  42. link proc RLOUT(DEV, X);
  43. \Output the real number X to the specified device.
  44. \Other inputs: MDIGIT, NDIGIT.
  45. int    DEV;
  46. real    X;
  47. int    MDIGIT, NDIGIT, M, NEG, EXP;
  48. addr    ADDR;
  49. real    ZERO, ONE, TEN, KILO;
  50.  
  51.  
  52.  
  53. proc    RLOUTX(DEV, X);
  54. \Output the real number X to the specified device.
  55. \Other inputs: M, NDIGIT.
  56. int    DEV;
  57. real    X;
  58. real    SX, RND, HALF, ONE, TEN;
  59. int    I, K, L, NEG;
  60. def    SIGFIGS =15;    \Maximum number of decimal digits
  61.  
  62.  
  63.     proc    DIGITOUT;
  64.     int    DIGIT;
  65.     begin
  66.     for I:= 1, K do
  67.         begin
  68.         if L > 0 then
  69.             begin
  70.             X:= X *TEN;
  71.             DIGIT:= FIX(X -HALF);
  72.             CHOUT(DEV, DIGIT +^0);
  73.             X:= X -FLOAT(DIGIT);
  74.             L:= L -1;
  75.             end
  76.         else    CHOUT(DEV,^0);
  77.         end;
  78.     end;    \DIGITOUT
  79.  
  80.  
  81. begin    \RLOUTX
  82. TEN:= FLOAT(10);
  83. ONE:= FLOAT(1);
  84. HALF:= ONE /FLOAT(2);
  85. if X < FLOAT(0) then [X:= -X;   NEG:= true] else NEG:= false;
  86.  
  87. K:= 0;
  88. SX:= X;            \Save original number to determine leading zero
  89. if X # FLOAT(0) then
  90.     begin
  91.     while X >= ONE do [X:= X /TEN;   K:= K +1];
  92.  
  93.     \Add in rounding factor: 0.5 * 10 ^ -(K+NDIGIT)
  94.     RND:= HALF;
  95.     L:= K +NDIGIT;
  96.     if L > SIGFIGS then L:= SIGFIGS;
  97.     for I:= 1, L do RND:= RND /TEN;
  98.     X:= X +RND;
  99.  
  100.     if X >= ONE then
  101.         [X:= X /TEN;   K:= K +1;    \Adjust for round overflow
  102.         SX:= TEN];            \Forget about leading zero
  103.     end;
  104.  
  105. \Calculate the number of leading blanks needed:
  106. L:= M -K;
  107. if SX < ONE then L:= L-1;        \Leave room for leading zero
  108. for I:= 1, L do CHOUT(DEV,^ );
  109. CHOUT(DEV, if NEG then ^- else ^ );
  110. if SX < ONE then CHOUT(DEV,^0);        \Output leading zero, E.G: 0.2
  111.  
  112. L:= SIGFIGS;
  113. DIGITOUT;                \Output digits in front of the D.P.
  114. if NDIGIT > 0 then            \Output digits after D.P.
  115.     [CHOUT(DEV, ^.);   K:= NDIGIT;   DIGITOUT];
  116. end;    \RLOUTX
  117.  
  118.  
  119.  
  120. proc    EXPOUT;
  121. begin
  122. if NEG then X:= -X;
  123. RLOUTX(DEV, X);
  124. CHOUT(DEV, ^E);
  125. CHOUT(DEV, if EXP < 0 then ^- else ^+);
  126. EXP:= ABS(EXP);
  127. if EXP < 10 then CHOUT(DEV, ^0);
  128. INTOUT(DEV, EXP);
  129. end;    \EXPOUT
  130.  
  131.  
  132.  
  133. begin    \RLOUT
  134. ADDR:= $7FE;
  135. MDIGIT:= EXTEND(ADDR(0));
  136. NDIGIT:= ADDR(1);
  137.  
  138. if MDIGIT >= 1 then [M:= MDIGIT;   RLOUTX(DEV, X);   return];
  139.  
  140. ZERO:= FLOAT(0);
  141. ONE:= FLOAT(1);
  142. TEN:= FLOAT(10);
  143. KILO:= FLOAT(1000);
  144.  
  145. if X < ZERO then [X:= -X;   NEG:= true] else NEG:= false;
  146. EXP:= 0;
  147.  
  148. if MDIGIT = 0 then            \Scientific notation
  149.     begin                \E.G: 1.2E+23, 1.2E-102, 1.2E+02
  150.     M:= 2;
  151.     if X # ZERO then
  152.         begin
  153.         while X < ONE do [X:= X *TEN;   EXP:= EXP -1];
  154.         while X >= TEN do [X:= X /TEN;   EXP:= EXP +1];
  155.         end;
  156.     EXPOUT;
  157.     end
  158. else    begin                \Engineering notation
  159.     M:= 4;
  160.     if X # ZERO then
  161.         begin
  162.         while X < ONE do [X:= X *KILO;   EXP:= EXP -3];
  163.         while X >= KILO do [X:= X /KILO;   EXP:= EXP +3];
  164.         end;
  165.     EXPOUT;
  166.     end;
  167. end;    \RLOUT
  168.  
  169. \----------------------------------------------------------------------
  170.  
  171. link func real RLIN(DEV);
  172. \Read in the ASCII representation of a real number from the specified device
  173. \ and return its value.
  174. int    DEV;    \Input device
  175. int    CH,    \Character
  176.     EX,    \Power-of-ten exponent, total effective value
  177.     N,    \Exponent as specified by input
  178.     NEG,    \Flag: Negative real number
  179.     ENEG,    \Flag: Negative exponent
  180.     DIGIT;    \Flag: Last character is a digit (0 thru 9)
  181. real    X,    \Value of real number
  182.     TEN;    \1.0, Avoids use of real constants which are not as easily
  183.         \ ported from one floating point representation to another.
  184.  
  185.  
  186.     proc    GETCH;        \Get character from input device
  187.     begin
  188.     CH:= CHIN(DEV);
  189.     DIGIT:= CH>=^0 & CH<=^9;    \Is it a digit?
  190.     end;    \GETCH
  191.  
  192.  
  193.     proc    ADDIN;
  194.     begin
  195.     X:= X *TEN + FLOAT(CH -^0);
  196.     end;    \ADDIN
  197.  
  198.  
  199. begin    \RLIN
  200. TEN:= FLOAT(10);
  201. NEG:= false;
  202. loop    begin
  203.     GETCH;            \Ignore any leading garbage
  204.     if CH =^- then NEG:= not NEG;
  205.     if DIGIT then
  206.         begin
  207.         X:= FLOAT(CH -^0);
  208.         loop    begin
  209.             GETCH;
  210.             if not DIGIT then quit;
  211.             ADDIN;
  212.             end;
  213.         quit;
  214.         end;
  215.     if CH=^. then [X:= FLOAT(0); quit];
  216.     end;
  217. EX:= 0;
  218. if CH = ^. then
  219.     loop    begin
  220.         GETCH;
  221.         if not DIGIT then quit;
  222.         ADDIN;
  223.         EX:= EX -1;    \if X gets bigger, the exponent gets smaller
  224.         end;
  225. if CH=^E ! CH=^e then
  226.     begin
  227.     N:=0;
  228.     GETCH;
  229.     if CH = ^- then [ENEG:= true; GETCH] else ENEG:= false;
  230.     if CH = ^+ then GETCH;
  231.     while DIGIT do [N:= N *10 +(CH -^0); GETCH];
  232.     EX:= EX + (if ENEG then -N else N);
  233.     end;
  234. while EX < 0 do [X:= X /TEN; EX:= EX +1];
  235. while EX > 0 do [X:= X *TEN; EX:= EX -1];
  236. return if NEG then -X else X;
  237. end;    \RLIN
  238. ile EX < 0 do [X:= X /TEN; EX:= EX +1];
  239. while EX > 0 do [X:= X *TEN; EX:= E